home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 020 / modula.arc / SCREEN.MOD < prev   
Encoding:
Modula Implementation  |  1986-08-20  |  4.1 KB  |  139 lines
  1.  
  2. IMPLEMENTATION MODULE PcScreen;
  3.  
  4. FROM Strings IMPORT Length;
  5. FROM SYSTEM  IMPORT ADDRESS,GETREG,AX,SWI;
  6. FROM Environment IMPORT Ptr,SType,ScreenType,Screen,RowAdj,ColAdj,
  7.                         RowMax,ColMax,Locate;
  8.  
  9. PROCEDURE Cls;
  10. VAR r1,c1 : CARDINAL;
  11. BEGIN
  12.  Locate(1,1);
  13.  FOR r1 := RowMax TO 1 BY -1 DO    (*  clear by scrolling up / not trad. down *)
  14.    FOR c1 := 1 TO ColMax DO
  15.      Screen^[r1,c1].Code := ' ';
  16.      Screen^[r1,c1].Attr := CHR(7);
  17.    END
  18.  END
  19. END Cls;
  20.  
  21. PROCEDURE EraseLine(Row : CARDINAL);
  22. VAR c1 : CARDINAL;
  23. BEGIN
  24.   Row := RowAdj(Row);
  25.   FOR c1 := 1 TO ColMax DO
  26.     Screen^[Row,c1].Code := ' ';
  27.     Screen^[Row,c1].Attr := CHR(7);
  28.   END
  29. END EraseLine;
  30.  
  31. PROCEDURE ColorAdj( Color : CARDINAL) : CARDINAL;
  32. VAR
  33.   ColorBits,ReturnBits : BITSET;
  34.   invisible,bold,highlight,light,italic,underline,outline,shadow,
  35.   blink,reverse,normal: BITSET;
  36. BEGIN
  37.  invisible := {};   (* 0   PC *)
  38.  bold      := {0};  (* 1   GEM *)
  39.  highlight := {0};  (* 1   PC *)
  40.  light     := {1};  (* 2   GEM *)
  41.  italic    := {2};  (* 4   GEM *)
  42.  underline := {3};  (* 8   PC/GEM *)
  43.  outline   := {4};  (* 16  GEM *)
  44.  shadow    := {5};  (* 32  GEM *)
  45.  blink     := {6};  (* 64  PC *)
  46.  reverse   := {7};  (* 128 PC *)
  47.  normal    := {8};  (* 256 PC~GEM *)
  48.   ColorBits := BITSET(Color);
  49.   IF ScreenType = Mono THEN
  50.     IF ColorBits = invisible THEN RETURN 0;
  51.       ELSIF ColorBits * normal = normal THEN RETURN 7;
  52.       ELSIF ColorBits * reverse = reverse THEN RETURN 112;
  53.     ELSE
  54.       ReturnBits := {2,1,0};  (* Start with Normal *)
  55.       IF ColorBits * underline = underline THEN
  56.         ReturnBits := ReturnBits / {2,1};
  57.       END;
  58.       IF ColorBits * blink = blink THEN
  59.         ReturnBits := ReturnBits + {7};
  60.       END;
  61.       IF ColorBits * highlight = highlight THEN
  62.         ReturnBits := ReturnBits + {3};
  63.       END;
  64.       RETURN CARDINAL(ReturnBits);
  65.     END;
  66.   ELSE
  67.     (* Color Screen is being used.  IF generic (monochrome) colors are being
  68.        used, then translate.  Else used color supplied.  *)
  69.     CASE Color OF
  70.        2 : RETURN 2FH |       (*  color 1  underline / green & white *)
  71.        1 : RETURN 07H |       (*        7  normal  *)
  72.       10 : RETURN 2BH |       (*        9  bright/underline  *)
  73.        8 : RETURN 0FH |       (*        15 bright  *)
  74.        6 : RETURN 2FH+80H |   (*        17 blink/underline  *)
  75.        4 : RETURN 07H+80H |   (*        23 blink  *)
  76.       14 : RETURN 2BH+80H |   (*        25 bright/blink/underline  *)
  77.       12 : RETURN 0FH+80H |   (*        31 bright/blink  *)
  78.       16 : RETURN 20H       (*  inverse  *)
  79.      ELSE
  80.        RETURN Color;
  81.     END;
  82.   END; (* if *)
  83. END ColorAdj;
  84.  
  85.  
  86. PROCEDURE DisplayString(Row,Col,Color : CARDINAL; Str : ARRAY OF CHAR);
  87. VAR I : CARDINAL;
  88. BEGIN
  89. IF Length(Str) > 0 THEN
  90.   Color := ColorAdj(Color);
  91.   Row := RowAdj(Row); Col := ColAdj(Col);
  92.   FOR I := 0 TO (Length(Str)-1) DO
  93.      Screen^[Row,Col+I].Code := Str[I];
  94.      Screen^[Row,Col+I].Attr := CHR(Color);
  95.    END;
  96. END;
  97. END DisplayString;
  98.  
  99. PROCEDURE DisplayStringMid(Row,Col,Color : CARDINAL; Str : ARRAY OF CHAR;
  100.                            beg,len : CARDINAL);
  101. VAR
  102.   I : CARDINAL;
  103. BEGIN
  104.   Color := ColorAdj(Color);
  105.   Row := RowAdj(Row); Col := ColAdj(Col);
  106.   FOR I := beg TO (beg+len-1) DO
  107.     Screen^[Row,Col+I-beg].Code := Str[I];
  108.     Screen^[Row,Col+I-beg].Attr := CHR(Color);
  109.   END; (* for i *)
  110. END DisplayStringMid;
  111.  
  112. PROCEDURE WriteScreenChar(Row,Col,Color : CARDINAL; Letter : CHAR);
  113. BEGIN
  114.   Color := ColorAdj(Color);
  115.   Row := RowAdj(Row); Col := ColAdj(Col);
  116.   Screen^[Row,Col].Code := Letter;
  117.   Screen^[Row,Col].Attr := CHR(Color);
  118. END WriteScreenChar;
  119.  
  120. PROCEDURE ReadScreenChar(Row,Col : CARDINAL) : CHAR;
  121. BEGIN
  122.   Row := RowAdj(Row); Col := ColAdj(Col);
  123.   RETURN(Screen^[Row,Col].Code);
  124. END ReadScreenChar;
  125.  
  126. PROCEDURE WriteScreenCol(Row,Col,Color : CARDINAL);
  127. BEGIN
  128.   Row := RowAdj(Row); Col := ColAdj(Col);
  129.   Screen^[Row,Col].Attr := CHR(Color);
  130. END WriteScreenCol;
  131.  
  132. PROCEDURE ReadScreenCol(Row,Col : CARDINAL) : CARDINAL;
  133. BEGIN
  134.   Row := RowAdj(Row); Col := ColAdj(Col);
  135.   RETURN(ORD(Screen^[Row,Col].Attr));
  136. END ReadScreenCol;
  137.  
  138. END PcScreen.
  139.